home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGSCAL / TBUTIL1.LZH / TURBO-UT.DEM < prev    next >
Text File  |  1984-09-11  |  10KB  |  287 lines
  1. {.HETURBO-UT.PAS : Pascal tools for application development            #}
  2. { * TURBO-UT.PAS ram/rom *                                }
  3. { * by Don Ramsey and Larry Romero *                   }
  4. { * March-April-May 1984 *                             }
  5.  
  6. program turbo_ut;
  7.  
  8.  {$I UT-MOD00.INC }   { load global variables }
  9.  
  10. {**********************************************************}
  11. {*  Shell-Module 01                                       *}
  12. {*  Purpose:            Misc. utilities and commands      *}
  13. {**********************************************************}
  14.  
  15.  {$I UT-MOD01.INC }
  16.  
  17. {**********************************************************}
  18. {*  Shell-Module 02                                       *}
  19. {*  Purpose: Input procedures and commands.               *}
  20. {*       These modules are required for use with          *}
  21. {*       the Input Procedure but can be used any time.    *}
  22. {**********************************************************}
  23.  
  24.  {$I UT-MOD02.INC }
  25.  
  26. {******************************************************************}
  27. {*  Shell-Module 03                                               *}
  28. {*  Purpose : Handle Variables for the Input procedure.           *}
  29. {*      These routines handle all input for NEW variables and     *}
  30. {*      CHANGES for old inputs. They handle all prompting,        *}
  31. {*      defaults, and validation.                                 *}
  32. {******************************************************************}
  33.  
  34.  {$I UT-MOD03.INC }
  35.  
  36. {******************************************************************}
  37. {*  Shell-Module 04                                               *}
  38. {*  Purpose : Provide a Lotus Type Menu.                          *}
  39. {*      This routine handles all Menu Selections and Prompting    *}
  40. {*      for a Lotus Menu. Ths programmer provides Selections      *}
  41. {*      and prompts before calling the routine.                   *}
  42. {*  Requires Global Procedures:                                   *}
  43. {*      Set_Cap_Num, Ck_edit_key                                  *}
  44. {******************************************************************}
  45.  
  46.  {$I UT-MOD04.INC }
  47.  
  48. {.pa}
  49. {******************************************************************}
  50. {*  Shell-Module 10                                               *}
  51. {*  Purpose : Provide Demonstrations for the Shell-Modules.       *}
  52. {*      These demos are instructive for the calling of            *}
  53. {*      the above Procedures.                                     *}
  54. {******************************************************************}
  55.  
  56. procedure Input2Demo;
  57.    { Demo the Input_Handler procedure }
  58.  var change:boolean;
  59.  
  60.  procedure Demo_Exit;
  61.   begin
  62.    Set_Cap_Num(' ',' ',' ');
  63.    prompt('Press <E> to exit, <C> to make Changes, or',
  64.           'Any Other Key to repeat Demo');
  65.    Read(kbd,Ch); Ch:=upcase(Ch);
  66.    if Ch='C' then Change:=true else Change:=false;
  67.   end;
  68.  
  69. begin
  70.  repeat  { repeat Demo until user exits }
  71.    clrscr; LowVideo;
  72.  
  73.    P[1]:='4013A03001-020201';
  74.    P[2]:='4014N00702-010301';
  75.    P[3]:='4016F00103-010403';
  76.    P[4]:='4017F00204-010402';
  77.    P[5]:='4019$00705-010501';
  78.  
  79.    fillchar(S,100,#205); S:=copy(S,1,80);
  80.  
  81.    Highvideo; Center('INPUT_HANDLER DEMO',2,1,78); Lowvideo; writeln;
  82.    write(S);
  83.    Center('This routine allows full screen input of variables.',2,3,78);
  84.    Center('It also contains routines that allow the Programmer to',2,4,78);
  85.    Center('specify prompt lines on the bottom 2 lines of the screen',2,5,78);
  86.    Center('as well as validate the entries.',2,6,78);
  87.    Center('However, probably the best feature is the ability to allow',2,7,78);
  88.    Center('corrections to be made at any time by the user!!!',2,8,78);
  89.    Center('GIVE IT A TRY',2,10,78); writeln;
  90.    write(S); gotoXY(1,22); write(S);
  91.  
  92.    Msg('Alphanumeric Input Routine',3,13);
  93.    Msg('Numeric Input Routine',3,14);
  94.    Msg('Formatted Input Routine',3,16);
  95.    Msg('Formatted Input Routine',3,17);
  96.    Msg('Dollar Input Routine',3,19);
  97.  
  98.    Input_Handler('N0105',Escape); {Escape returned from Input_handler}
  99.  
  100.    if not Escape then  {Escape is exit by pressing <F1> at the 1st entry}
  101.     begin
  102.        repeat
  103.          Demo_Exit;
  104.          if Change then Input_Handler('C0105',Escape);
  105.        until (Change=false) or (Escape);
  106.     end;
  107.  until (Ch='E') or (Escape); { end repeat Demo }
  108. end;
  109.  
  110. procedure Demo1;
  111.    { *** Demo of the Box, Center, & ClrWnd procedure *** }
  112.  var I: integer;
  113.  begin
  114.    ClrScr;
  115.    Box(1,1,38,20,1); Box(42,1,80,20,5);
  116.    Center('* This is Window #1 *',2,3,36);
  117.    Center('* This is Window #2 *',43,3,36); LowVideo;
  118.    for I:=7 to 19 do
  119.     begin
  120.       gotoXY(4,I);  write('#1 #1    #1    #1 #1    #1    #1');
  121.       gotoXY(45,I); write('#2 #2    #2    #2 #2    #2    #2');
  122.     end;
  123.    Prompt(' ','Press any key to Clear Window #1');  Option;
  124.    Prompt(' ',' ');
  125.    ClrWnd(4,7,39,19);
  126.    Prompt(' ','Press any key to Clear Window #2');  Option;
  127.    Center('***   Clearing   ***',43,3,36); Prompt('','');
  128.    ClrWnd(43,7,79,19);
  129.    prompt('','Press any key to continue...');  Option;
  130.  end;  {* Demo1 *}
  131.  
  132. procedure InputDemo;
  133.     { Demo the input routines and display the returned values }
  134. begin
  135.  repeat
  136.    clrscr; LowVideo;
  137.    write('   Alphanumeric Input Routine');
  138.     Input('A','This is Default',40,1,30,true,F1,F10);
  139.      writeln; writeln('Returned  : ',Answer);
  140.    Msg('Numeric Input Routine',3,5);
  141.      Input('N','',40,5,7,true,F1,F10);
  142.       writeln; writeln('Returned : ',Answer);
  143.    Msg('Formatted Input Routine',3,9);
  144.      Input('F','',40,9,1,true,F1,F10);
  145.       writeln; writeln('Returned : ',answer);
  146.    Msg('Formatted Input Routine',3,13);
  147.      Input('F','',40,13,2,true,F1,F10);
  148.       writeln; writeln('Returned : ',answer);
  149.    Msg('Dollar Input Routine',3,17);
  150.      Input('$','',40,17,7,true,F1,F10);
  151.       writeln; writeln('Returned : ',answer); writeln(' ');
  152.    write('Press <E> to exit or Any Key to repeat Demo');
  153.    Read(kbd,Ch); Ch:=upcase(Ch);
  154.  until Ch='E';
  155. end;
  156.  
  157. {.pa}
  158. procedure L_Menu_Dem;
  159.   procedure Get_var;
  160.     { Lotus Menu Items, Prompts }
  161.     begin
  162.       P[1]:= 'Arrow  .Arrow keys will move the cursor' ;
  163.       P[2]:= 'Home   .The Home/End keys are active'    ;
  164.       P[3]:= 'Space  .Space Bar works too'             ;
  165.       P[4]:= 'Locate .The menu may be located anywhere';
  166.       P[5]:= 'Prompts.Prompts are programmer definable';
  167.       P[6]:= 'Choices.Choices too are easily redefined';
  168.       P[7]:= 'Quit   .Quit this program '              ;
  169.       P[8]:= ' ';
  170.     end;
  171.   begin
  172.     ClrScr; LowVideo;
  173.     HighVideo; Center('L O T U S   M E N U   D E M O',1,10,80); LowVideo;
  174.     Center('Use the Arrow Keys, Home, End, and Space Bar to move the cursor'
  175.       ,1,13,80);
  176.     Center('All Menu Items and Prompts are PROGARMMER defined',1,15,80);
  177.     Box(1,4,80,22,6);
  178.     repeat
  179.       Get_var; Hmenu(1,2,'Lotus Menu',Ch);
  180.       case Ch of
  181.         'Q' : Exit :=true;
  182.       end;
  183.       gotoXY(10,25);write('Returned: ',Ch);
  184.     until Exit = true;
  185.     Exit :=false;
  186.   end;
  187.  
  188. procedure FmtDemo;
  189.  var num   : real;
  190.      Nums  : array[1..10] of real;
  191.      I     : integer;
  192.  begin
  193.    clrscr; Nums[1]:=1; for I:=2 to 10 do Nums[I]:=(Nums[i-1]+i)*4.35;
  194.    for I:=1 to 10 do
  195.     begin
  196.       gotoXY(1,4+i); write('This number   ',Nums[I]:12:4);
  197.       gotoXY(32,4+i); writeln('  Formatted is  ',fmt_real(nums[I],14,2));
  198.     end;
  199.    writeln;writeln;
  200.    write('The number     - 999999.99  ');
  201.    write('     Formatted is  ',fmt_real(-999999.99,14,2)); writeln;
  202.    write('The number    - 999999.999  ');
  203.    write('     Formatted is  ',fmt_real(-999999.999,14,2));
  204.    gotoXY(1,22); write('Press any key to continue...'); read(kbd,ch);
  205.  end;
  206.  
  207. procedure FlashDemo;
  208.  var i,j: integer;
  209.   begin
  210.     clrscr;
  211.     for i:=1 to 24 do
  212.      begin
  213.        for j:=1 to i do write(' ');
  214.        writeln('This is a demo of the FlashScreen procedure');
  215.      end;
  216.     write('Press any key to Save screen in Memory'); read(kbd,ch);
  217.     SaveScreen; clrscr; write('Press any key to Flash the screen you Saved');
  218.     read(kbd,ch); FlashScreen; gotoXY(1,25); clreol;
  219.     write('Press any key to continue...'); read(kbd,ch);
  220.     First_run:=true;
  221.   end;
  222.  
  223. {.pa}
  224. {************************************************************}
  225. {*  Source Code Module: UT-MOD90                            *}
  226. {*  Purpose:            Main Menu Module : Program Control  *}
  227. {************************************************************}
  228.  
  229. procedure ProgramExit;
  230.  begin
  231.    Clrscr; Center('This Program is about to end',1,11,80);
  232.    highvideo; Center('Verify Ok (Y/N)',1,13,80); lowvideo;
  233.    repeat
  234.      Option; if not (Ch in ['Y','N']) then beep(350,150);
  235.    until Ch in ['Y','N'];
  236.  end;
  237.  
  238. procedure MainMenu;
  239.  var I,Tab: integer;
  240.      Okchoices: set of char;
  241.   begin
  242.    if First_run then
  243.     begin
  244.      ClrScr; HighVideo;
  245.      Center('*** MAIN  MENU ***  ',1,4,80); LowVideo;
  246.      for I:= 1 to 4 do  writeln('');
  247.      Tab:= 25;
  248.      writeln('':Tab,'<1> Window & Centering Demo');
  249.      writeln('':Tab,'<2> Demo of Input Routines'); writeln('');
  250.      writeln('':Tab,'<3> Lotus Type Menu Demo');
  251.      writeln('':Tab,'<4> Input Handler Demo');   writeln('');
  252.      writeln('':Tab,'<5> Number Formatting Demo');
  253.      writeln('':Tab,'<6> Screen Flash Demo'); writeln('');
  254.      writeln('':Tab,'<7> Exit the Demo'); writeln('');
  255.      Box(20,2,60,20,6);writeln('');
  256.      SaveScreen; First_run:=false;
  257.     end else FlashScreen;
  258.     Set_Cap_num(' ','N',' '); Say_Cap_Num;
  259.     Highvideo; Center('Press Your Selection',21,19,38); LowVideo;
  260.     OKchoices:=['1'..'7'];
  261.     repeat
  262.       Option; if not (Ch in OKchoices) then Beep(350,150);
  263.     until Ch in OKchoices;
  264.     case Ch of
  265.       '1' :  Demo1;
  266.       '2' :  InputDemo;
  267.       '3' :  L_Menu_Dem;
  268.       '4' :  Input2Demo;
  269.       '5' :  FmtDemo;
  270.       '6' :  FlashDemo;
  271.       '7' :  begin
  272.                ProgramExit; if Ch='Y' then Exit := true;
  273.              end;
  274.     end;
  275.   end;
  276.  
  277. {**********************************************************}
  278. {*              Program Starts Execution                  *}
  279. {**********************************************************}
  280.  
  281. begin
  282.   ClrScr; Exit:=false; First_run:=true;
  283.   repeat
  284.     MainMenu;
  285.   until Exit = true;
  286.   Color(0,7); lowvideo;
  287. end.